unit uDBConnPool;

interface

uses
  SysUtils, Classes, ADODB, Windows, uDZSysUtils, uDZSerializer, uDZLinkList,
  uDZTrace, uDZDataSetSerializer, uDZConfig, uDZDatabase,
  uCxtConst, uAppLog, uAppConfig, uCxtTypes;

type
  TADOAccess = class(TDzDblLinkListNode)
  private
    fConnection: TADOConnection;
    fQuery: TADOQuery;
    fStoredProc: TADOStoredProc;
    fClassReader: IDzClassReader;
    function GetConnectionString: WideString;
    procedure SetConnectionString(const Value: WideString);
  protected
    function Connect(out Error: TErrorInfo): Boolean;
  public
    constructor Create(_list: TDzDblLinkList); override;
    destructor Destroy; override;
    function ExecSQL(const sql: WideString; out Error: TErrorInfo;
      noRecords: Boolean = False; affected: PInteger = nil): Boolean;
    function ExecStoredProc(out Error: TErrorInfo;
      noRecords: Boolean = False): Boolean;
    function ExtractQuery: TADOQuery;
    function ExtractStoredProc: TADOStoredProc;
    property Connection: TADOConnection read fConnection;
    property Query: TADOQuery read fQuery;
    property StoredProc: TADOStoredProc read fStoredProc;
    property ClassReader: IDzClassReader read fClassReader;
    property ConnectionString: WideString read GetConnectionString
      write SetConnectionString;
  end;

  TADOConnectionPool = class
  private
    fConnList: TDzDblLinkList;
    fPoolSize: Integer;
    fSemaphore: THandle;
  public
    constructor Create;
    destructor Destroy; override;
    function GetConnection: TADOAccess;
    procedure ReleaseConnection(access: TADOAccess);
  end;

function GetDBConnPool: TADOConnectionPool;

implementation

var
  ConnPool: TADOConnectionPool;

function GetDBConnPool: TADOConnectionPool;
begin
  Result := ConnPool;
end;

{ TADOAccess }

function TADOAccess.Connect(out Error: TErrorInfo): Boolean;
begin
  try
    fConnection.Connected := True;
    Error.Code := CXT_E_SUCCESS;
    Result := True;
  except
    on E: Exception do
    begin
      LogException('ADOConnection.Open', E);
      Error.Code := CXT_E_DATABASE_UNREACHABLE;
      Error.Desc := SCannotConnectDB;
      Result := False;
    end;
  end;
end;

constructor TADOAccess.Create(_list: TDzDblLinkList);
begin
  fConnection := TADOConnection.Create(nil);
  fConnection.LoginPrompt := False;
  fQuery := TADOQuery.Create(nil);
  fQuery.Connection := fConnection;
  fStoredProc := TADOStoredProc.Create(nil);
  fStoredProc.Connection := fConnection;
  fClassReader := TDzDataSetClassReader.Create(fQuery);
  inherited;
end;

destructor TADOAccess.Destroy;
begin
  fQuery.Free;
  fStoredProc.Free;
  fConnection.Free;
  inherited;
end;

function TADOAccess.ExecSQL(const sql: WideString; out Error: TErrorInfo;
  noRecords: Boolean; affected: PInteger): Boolean;
begin
  Result := Connect(Error);
  if not Result then Exit;
  if sql <> '' then fQuery.SQL.Text := sql;
  while True do
  begin
    try
      if noRecords then
      begin
        if affected = nil then fQuery.ExecSQL
        else affected^ := fQuery.ExecSQL;
      end
      else fQuery.Open;
      Error.Code := CXT_E_SUCCESS;
      Result := True;
      Break;
    except
      on E: Exception do
      begin
        LogException('TADOQuery.Open', E);
        if CanReConnect(E.Message) then 
        begin
          fConnection.Connected := False;
          Result  := Connect(Error);
          if not Result then Break;
        end
        else Break;
      end;
    end;
  end;
end;

function TADOAccess.ExecStoredProc(out Error: TErrorInfo;
  noRecords: Boolean): Boolean;
begin
  Result := Connect(Error);
  if not Result then Exit;
  while True do
  begin
    try
      if noRecords then fStoredProc.ExecProc
      else fStoredProc.Open;
      Result := True;
      Break;
    except
      on E: Exception do
      begin
        LogException('TADOStoredProc.Open', E);
        if CanReConnect(E.Message) then
        begin
          fConnection.Connected := False;
          Result := Connect(Error);
          if not Result then Break;
        end
        else Break;
      end;
    end;
  end;
end;

function TADOAccess.ExtractQuery: TADOQuery;
var
  qry: TADOQuery;
begin
  qry := TADOQuery.Create(nil);
  qry.Connection := fConnection;
  qry.CommandTimeout := fQuery.CommandTimeout;
  Result := fQuery;
  fQuery := qry;
end;

function TADOAccess.ExtractStoredProc: TADOStoredProc;
var
  qry: TADOStoredProc;
begin
  qry := TADOStoredProc.Create(nil);
  qry.Connection := fConnection;
  qry.CommandTimeout := fStoredProc.CommandTimeout;
  Result := fStoredProc;
  fStoredProc := qry;
end;

function TADOAccess.GetConnectionString: WideString;
begin
  Result := fConnection.ConnectionString;
end;

procedure TADOAccess.SetConnectionString(const Value: WideString);
begin
  fConnection.ConnectionString := Value;
end;

{ TADOConnectionPool }

constructor TADOConnectionPool.Create;
begin
  fConnList := TDzDblLinkList.Create(TADOAccess, lmStack, True);
  fSemaphore := Windows.CreateSemaphore(nil, 0, $7fffffff, nil);
end;

destructor TADOConnectionPool.Destroy;
begin
  fConnList.Free;
  Windows.CloseHandle(fSemaphore);
  inherited;
end;

function TADOConnectionPool.GetConnection: TADOAccess;
begin
  fConnList.Lock;
  try
    Result := TADOAccess(fConnList.Pop);
    if Result <> nil then Exit;
    if fPoolSize < AppConfig.DBConnectionPoolSize then
    begin
      LockInc(fPoolSize);
      Result := TADOAccess.Create(nil);
      with TDzMSSQLADOCP(AppConfig.ConnParam) do
      begin
        Result.ConnectionString := ConnString;
        Result.Connection.ConnectionTimeout := ConnectionTimeout;
        Result.Query.CommandTimeout := CommandTimeout;
        Result.StoredProc.CommandTimeout := CommandTimeout;
      end;
      Exit;
    end;
    fConnList.Release;
    WaitForSingleObject(fSemaphore, INFINITE);
    fConnList.Lock;
    Result := TADOAccess(fConnList.Pop);
  finally
    fConnList.Release;
  end;
end;

procedure TADOConnectionPool.ReleaseConnection(access: TADOAccess);
begin
  access.StoredProc.Close;
  access.Query.Close;
  fConnList.LockPush(access);
  Windows.ReleaseSemaphore(fSemaphore, 1, nil);
end;

initialization
  ConnPool := TADOConnectionPool.Create;

finalization
  ConnPool.Free;
  
end.
